Analysis for Neginhib (Ann Nordmeyer, Erica Yoon, Mike Frank). The study included three games designed to test the relationship between inhibitory control, implicature processing, and negation processing. All games had a similar structure: participants saw two pictures and heard a word, and had to select the picture that goes with the word as quickly as possible. Each game had two trial types, labeled control and target in these analyses. The three games were:
Inhibition Game : Participants saw several identical trials in a row (e.g. the word “apple” with pictures of an apple and a cookie) and then saw a trial with the same pictures but a different word (e.g. “cookie” with pictures of an apple and a cookie). The repeated trials in each run are the control trials and the final trial in each run was the target trial, designed to measure inhibitory control.
Implicature Game: On control / unambiguous trials, participants saw two single pictures (e.g. a picture of an apple and a picture of a cookie) and heard a word referring to one of the pictures (e.g. “apple”). On target / implicatures trials, participants saw a picture with a single item and a picture with the same item paired with another item (e.g. a picture of an apple, and a picture of an apple and a cookie) and heard e.g. “apple”. The “correct” response on these trials is the response generated by the ad-hoc implicature, e.g. that “apple” must refer to the single apple because otherwise the speaker would have said “cookie”.
Negation Game: On control / positive trials, participants saw two pictures and heard a word referring to one of the pictures (e.g. a picture of an apple and a picture of a cookie, with the word “apple”). On target / negative trials, participants saw two pictures and heard a word negating one of the pictures (e.g. a picture of an apple and a picture of a cookie, with the words “no apple”).
Kids played these games at the CDM on a computer (4, 5, and 6-year-olds), with 60 trials per game. Adults completed the task on MTurk, with 120 trials per game. The adult version of the task can be viewed here: https://langcog.stanford.edu/expts/EJY/neginhib/v1/turk/neginhib_mturk.html
Load required Libraries
rm(list=ls())
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 3.2.3
library(dplyr)
##
## Attaching package: 'dplyr'
##
## The following objects are masked from 'package:stats':
##
## filter, lag
##
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(tidyr)
library(magrittr)
##
## Attaching package: 'magrittr'
##
## The following object is masked from 'package:tidyr':
##
## extract
library(RWiener)
library(knitr)
library(bootstrap)
library(gridExtra)
library(effsize)
library(lme4)
## Loading required package: Matrix
##
## Attaching package: 'Matrix'
##
## The following object is masked from 'package:tidyr':
##
## expand
library(GGally)
## Warning: package 'GGally' was built under R version 3.2.3
##
## Attaching package: 'GGally'
##
## The following object is masked from 'package:dplyr':
##
## nasa
Some useful functions:
# number of unique subs
n.unique <- function (x) {
length(unique(x))
}
# for bootstrapping 95% confidence intervals
theta <- function(x,xdata) {mean(xdata[x])}
ci.low <- function(x) {
quantile(bootstrap(1:length(x),1000,theta,x)$thetastar,.025)}
ci.high <- function(x) {
quantile(bootstrap(1:length(x),1000,theta,x)$thetastar,.975)}
Load in data
RT trimming:
d.turk <- read.csv("../long_data/long_data_mturk.csv")
n.turk.initial <- n.unique(d.turk$subid)
d.turk <- d.turk %>%
# remove anyone who played fewer than 300 trials (means they did not complete at least half of the third game) or over 408 trials (means they completed the task twice, because 408 is max number of trials -- this only happened for one participant and I'm not sure how they were able to do this, so I'm rejecting them)
mutate(subid = factor(subid)) %>%
group_by(subid) %>%
mutate(ntrials = n()) %>%
filter(ntrials > 300 & ntrials < 408) %>%
ungroup() %>%
# create resp and rt vars
mutate(resp = factor(response, levels=c("Y","N"), labels=c("upper","lower")),
q = rt/1000) %>%
# remove outlier RTs
filter(rt > 200,
rt < 15000) %>% # filtering the mysterious neg rt...
filter(log(rt) < mean(log(rt)) + 3 * sd(log(rt)),
log(rt) > mean(log(rt)) - 3 * sd(log(rt))) %>%
# clean up
select(subid, game, trial.num, trial.type, q, resp) %>%
mutate(agegroup = "adults") %>%
ungroup()
n.turk.final <- n.unique(d.turk$subid)
d.cdm.raw <- read.csv("../long_data/long_data_cdm.csv") %>%
filter(agegroup == 4 | agegroup == 5 | agegroup == 6)
n.cdm.initial <- n.unique(d.cdm.raw$subid)
d.cdm <- d.cdm.raw %>%
# remove any child who played fewer than 150 trials (means they didn't complete at least half of the final game)
group_by(subid) %>%
mutate(ntrials = n()) %>%
filter(ntrials > 150) %>%
ungroup() %>%
group_by(agegroup) %>% #Note: doing rt trimming within age group for this sample
# create resp and rt vars
mutate(resp = factor(response, levels=c("Y","N"), labels=c("upper","lower")),
q = rt/1000) %>%
# remove outlier RTs
filter(rt > 200,
rt < 15000) %>% # filtering the mysterious neg rt...
filter(log(rt) < mean(log(rt)) + 3 * sd(log(rt)),
log(rt) > mean(log(rt)) - 3 * sd(log(rt))) %>%
ungroup()
m_age_comp <- aggregate(age ~ agegroup, d.cdm, mean)
min_age_comp <- aggregate(age ~ agegroup, d.cdm, min)
max_age_comp <- aggregate(age ~ agegroup, d.cdm, max)
d.cdm <- d.cdm %>%
# clean up
select(subid, age, agegroup, game, trial.num, trial.type, q, resp) %>%
mutate(agegroup = factor(agegroup)) %>%
ungroup()
n.cdm.final <- n.unique(d.cdm$subid)
ns.cdm <- aggregate(subid ~ agegroup, d.cdm, n.unique)
d <- bind_rows(d.turk, d.cdm)
d$subid <- factor(d$subid)
d$agegroup <- factor(d$agegroup, levels = c("adults", "4", "5", "6"))
d$trial.labels <- factor(d$trial.type, levels = c("control", "inhib", "unambiguous", "implicature", "positive", "negative"))
d$correct <- as.numeric(as.character(factor(d$resp,
levels=c("upper","lower"),
labels=c("1","0"))))==1
d$trial.type <- factor(d$trial.type %in% c("inhib","implicature","negative"),
levels = c(FALSE, TRUE),
labels = c("control","target"))
d$game <- factor(d$game, levels=c("inhibition","implicature","negation"))
d <- d %>%
mutate(agegroup2 = ifelse(agegroup == "adults", "adults", "kids"))
We excluded 2 adult participants and 24 child participants for failing to complete at least half of the trials in each game. This left a final sample of 48 adult participants and 66 child participants (22 4-year-olds (age range 4.01-4.99, mean age = 4.6), 19 5-year-olds (age range 5.03-5.95, mean age = 5.49), and 25 6-year-olds (age range 6-6.99, mean age = 6.46)).
Proportion correct:
ms.acc <- d %>%
group_by(game, trial.type, subid, agegroup) %>%
summarise(m = mean(correct)) %>%
group_by(game, trial.type, agegroup) %>%
summarise(cih = ci.high(m),
cil = ci.low(m),
m = mean(m))
ms.acc$agegroup <- factor(ms.acc$agegroup,
levels = c("4", "5", "6", "adults"),
labels = c("4", "5", "6", "Adults"))
ms.acc$trial.type <- factor(ms.acc$trial.type, labels = c("Control", "Target"))
ms.acc$game <- factor(ms.acc$game, labels = c("Inhibition", "Implicature", "Negation"))
ms.acc$kid <- ms.acc$agegroup != "Adults"
qplot(data = ms.acc, x = agegroup, y = m, color = trial.type,
geom = "point", position = position_dodge(.2)) +
geom_errorbar(aes(ymin = cil, ymax = cih),
position = position_dodge(.2), width = 0) +
geom_line(aes(group = interaction(kid,trial.type), col = trial.type)) +
facet_grid( ~ game) +
ylab("Proportion correct") + xlab("Age Group") +
scale_color_hue(name = "Trial Type") +
theme_bw()
So kids are much less accurate than adults on target trials, especially in the implicature and negation games. In general, both adults and kids have lower accuracy on target trials. It looks children show some improvement on the implicatures game across development but maybe not so much improvement across development on the negation game?
Do kids differ from adults in accuracy?
##Inhibition:
correct.inhib <- glmer(correct ~ trial.type * agegroup2 + (trial.type | subid),
data = filter(d, game == "inhibition"),
family = "binomial")
kable(summary(correct.inhib)$coefficients, digits = 3)
| Estimate | Std. Error | z value | Pr(>|z|) | |
|---|---|---|---|---|
| (Intercept) | 4.490 | 0.190 | 23.615 | 0.000 |
| trial.typetarget | -2.096 | 0.202 | -10.381 | 0.000 |
| agegroup2kids | -1.450 | 0.236 | -6.137 | 0.000 |
| trial.typetarget:agegroup2kids | 0.629 | 0.247 | 2.545 | 0.011 |
##Implicature:
correct.imp <- glmer(correct ~ trial.type * agegroup2 + (trial.type | subid),
data = filter(d, game == "implicature"),
family = "binomial")
kable(summary(correct.imp)$coefficients, digits = 3)
| Estimate | Std. Error | z value | Pr(>|z|) | |
|---|---|---|---|---|
| (Intercept) | 3.369 | 0.156 | 21.657 | 0.000 |
| trial.typetarget | -1.145 | 0.213 | -5.384 | 0.000 |
| agegroup2kids | -0.949 | 0.196 | -4.852 | 0.000 |
| trial.typetarget:agegroup2kids | 0.122 | 0.273 | 0.448 | 0.654 |
##Negation:
correct.neg <- glmer(correct ~ trial.type * agegroup2 + (trial.type | subid),
data = filter(d, game == "negation"),
family = "binomial")
kable(summary(correct.neg)$coefficients, digits = 3)
| Estimate | Std. Error | z value | Pr(>|z|) | |
|---|---|---|---|---|
| (Intercept) | 2.746 | 0.158 | 17.379 | 0.000 |
| trial.typetarget | -0.179 | 0.279 | -0.643 | 0.520 |
| agegroup2kids | 0.190 | 0.220 | 0.863 | 0.388 |
| trial.typetarget:agegroup2kids | -1.984 | 0.375 | -5.296 | 0.000 |
Is there developmental change from 4 to 6 years?
##Inhibition:
correct.inhib.kids <- glmer(correct ~ trial.type * age + (trial.type | subid),
data = filter(d, game == "inhibition",
agegroup != "adults"),
family = "binomial")
kable(summary(correct.inhib.kids)$coefficients, digits = 3)
| Estimate | Std. Error | z value | Pr(>|z|) | |
|---|---|---|---|---|
| (Intercept) | 0.038 | 0.984 | 0.039 | 0.969 |
| trial.typetarget | 2.311 | 1.002 | 2.306 | 0.021 |
| age | 0.549 | 0.177 | 3.096 | 0.002 |
| trial.typetarget:age | -0.700 | 0.179 | -3.905 | 0.000 |
##Implicature:
correct.imp.kids <- glmer(correct ~ trial.type * age + (trial.type | subid),
data = filter(d, game == "implicature",
agegroup != "adults"),
family = "binomial")
kable(summary(correct.imp.kids)$coefficients, digits = 3)
| Estimate | Std. Error | z value | Pr(>|z|) | |
|---|---|---|---|---|
| (Intercept) | 0.597 | 0.797 | 0.749 | 0.454 |
| trial.typetarget | -0.368 | 1.227 | -0.300 | 0.764 |
| age | 0.329 | 0.143 | 2.299 | 0.021 |
| trial.typetarget:age | -0.119 | 0.219 | -0.542 | 0.588 |
##Negation:
correct.neg.kids <- glmer(correct ~ trial.type * age + (trial.type | subid),
data = filter(d, game == "negation",
agegroup != "adults"),
family = "binomial")
kable(summary(correct.neg.kids)$coefficients, digits = 3)
| Estimate | Std. Error | z value | Pr(>|z|) | |
|---|---|---|---|---|
| (Intercept) | 2.679 | 1.230 | 2.177 | 0.029 |
| trial.typetarget | -2.467 | 2.226 | -1.109 | 0.268 |
| age | 0.071 | 0.217 | 0.327 | 0.744 |
| trial.typetarget:age | 0.030 | 0.395 | 0.075 | 0.940 |
What about reaction time? Here we just look at RTs on correct trials (outlier RTs were trimmed earlier when the data was loaded).
#Plot data
ms.rt <- d %>%
filter(correct == TRUE) %>%
group_by(game, trial.type, subid, agegroup) %>%
summarise(m = mean(q)) %>%
group_by(game, trial.type, agegroup) %>%
summarise(cih = ci.high(m),
cil = ci.low(m),
m = mean(m))
ms.rt$agegroup <- factor(ms.rt$agegroup,
levels = c("4", "5", "6", "adults"),
labels = c("4", "5", "6", "Adults"))
ms.rt$game <- factor(ms.rt$game, labels = c("Inhibition", "Implicature", "Negation"))
ms.rt$trial.type <- factor(ms.rt$trial.type, labels = c("Control", "Target"))
ms.rt$kid <- ms.rt$agegroup != "Adults"
qplot(data = ms.rt, x = agegroup, y = m, color = trial.type,
geom = "point", position = position_dodge(.2)) +
geom_errorbar(aes(ymin = cil, ymax = cih),
position = position_dodge(.2), width = 0) +
geom_line(aes(group = interaction(kid,trial.type), col = trial.type)) +
facet_grid( ~ game) +
ylab("RT (s)") + xlab("Age Group") +
scale_color_hue(name = "Trial Type") +
theme_bw()
Are kids significantly slower than adults?
##Inhibition:
rt.inhib <- lmer(q ~ trial.type * agegroup2 + (trial.type | subid),
data = filter(d, game == "inhibition",
correct == TRUE))
kable(summary(rt.inhib)$coefficients, digits = 3)
| Estimate | Std. Error | t value | |
|---|---|---|---|
| (Intercept) | 0.641 | 0.034 | 18.906 |
| trial.typetarget | 0.140 | 0.014 | 9.709 |
| agegroup2kids | 0.628 | 0.045 | 14.011 |
| trial.typetarget:agegroup2kids | 0.094 | 0.023 | 4.056 |
##Implicature:
rt.imp <- lmer(q ~ trial.type * agegroup2 + (trial.type | subid),
data = filter(d, game == "implicature",
correct == TRUE))
kable(summary(rt.imp)$coefficients, digits = 3)
| Estimate | Std. Error | t value | |
|---|---|---|---|
| (Intercept) | 0.933 | 0.050 | 18.590 |
| trial.typetarget | -0.011 | 0.029 | -0.400 |
| agegroup2kids | 0.933 | 0.067 | 14.022 |
| trial.typetarget:agegroup2kids | -0.026 | 0.040 | -0.637 |
##Negation:
rt.neg <- lmer(q ~ trial.type * agegroup2 + (trial.type | subid),
data = filter(d, game == "negation",
correct == TRUE))
kable(summary(rt.neg)$coefficients, digits = 3)
| Estimate | Std. Error | t value | |
|---|---|---|---|
| (Intercept) | 0.952 | 0.041 | 23.485 |
| trial.typetarget | 0.009 | 0.027 | 0.325 |
| agegroup2kids | 0.686 | 0.054 | 12.721 |
| trial.typetarget:agegroup2kids | 0.148 | 0.040 | 3.715 |
Do kids RTs change developmentally?
##Inhibition:
rt.inhib.kids <- lmer(q ~ trial.type * age + (trial.type | subid),
data = filter(d, game == "inhibition",
agegroup != "adults",
correct == TRUE))
kable(summary(rt.inhib.kids)$coefficients, digits = 3)
| Estimate | Std. Error | t value | |
|---|---|---|---|
| (Intercept) | 2.432 | 0.203 | 11.951 |
| trial.typetarget | 0.023 | 0.187 | 0.124 |
| age | -0.209 | 0.036 | -5.775 |
| trial.typetarget:age | 0.038 | 0.033 | 1.139 |
##Implicature:
rt.imp.kids <- lmer(q ~ trial.type * age + (trial.type | subid),
data = filter(d, game == "implicature",
agegroup != "adults",
correct == TRUE))
kable(summary(rt.imp.kids)$coefficients, digits = 3)
| Estimate | Std. Error | t value | |
|---|---|---|---|
| (Intercept) | 3.307 | 0.328 | 10.088 |
| trial.typetarget | -0.248 | 0.261 | -0.949 |
| age | -0.259 | 0.058 | -4.442 |
| trial.typetarget:age | 0.037 | 0.046 | 0.807 |
##Negation:
rt.neg.kids <- lmer(q ~ trial.type * age + (trial.type | subid),
data = filter(d, game == "negation",
agegroup != "adults",
correct == TRUE))
kable(summary(rt.neg.kids)$coefficients, digits = 3)
| Estimate | Std. Error | t value | |
|---|---|---|---|
| (Intercept) | 3.005 | 0.245 | 12.255 |
| trial.typetarget | 0.687 | 0.251 | 2.733 |
| age | -0.246 | 0.044 | -5.638 |
| trial.typetarget:age | -0.095 | 0.044 | -2.132 |
So it looks like for both adults and children there is only an effect of trial type (e.g. control vs. target) on the inhibition game, where both adults and children were slower on the target trials. Older children are faster than younger children, on all games.
Is there any correlation between an individual’s performance on one game vs. another game?
ms.acc.kids <- d %>%
filter(agegroup2 == "kids") %>%
group_by(subid, game, trial.type) %>%
summarise(correct = mean(correct)) %>%
spread(trial.type, correct) %>%
mutate(sdiff = scale(target - control)) %>%
select(-control, -target) %>%
spread(game, sdiff)
ms.acc.adults <- d %>%
filter(agegroup2 == "adults") %>%
group_by(subid, game, trial.type) %>%
summarise(correct = mean(correct)) %>%
spread(trial.type, correct) %>%
mutate(sdiff = scale(target - control)) %>%
select(-control, -target) %>%
spread(game, sdiff)
ms.rt.kids <- d %>%
filter(correct == TRUE, agegroup2 == "kids") %>%
group_by(subid, game, trial.type) %>%
summarise(rt = mean(q)) %>%
spread(trial.type, rt) %>%
mutate(sdiff = scale(target - control)) %>%
select(-control, -target) %>%
spread(game, sdiff)
ms.rt.adults <- d %>%
filter(correct == TRUE, agegroup2 == "adults") %>%
group_by(subid, game, trial.type) %>%
summarise(rt = mean(q)) %>%
spread(trial.type, rt) %>%
mutate(sdiff = scale(target - control)) %>%
select(-control, -target) %>%
spread(game, sdiff)
First let’s look at individual differences in accuracy for adults:
ggpairs(data = ms.acc.adults,
columns = 2:4,
upper = list(continuous = "cor"),
lower = list(continuous = "smooth")) +
theme_bw()
inhibimp_accadults <- cor.test(ms.acc.adults$inhibition, ms.acc.adults$implicature)
inhibneg_accadults <- cor.test(ms.acc.adults$inhibition, ms.acc.adults$negation)
negimp_accadults <- cor.test(ms.acc.adults$negation, ms.acc.adults$implicature)
There is no significant correlation between inhibition and implicature accuracy (r = 0.21, p = 0.16) or inhibition and negation accuracy (r = -0.11, p = 0.46).
What about for kids’ accuracy?
ggpairs(data = ms.acc.kids,
columns = 2:4,
upper = list(continuous = "cor"),
lower = list(continuous = "smooth")) +
theme_bw()
inhibimp_acckids <- cor.test(ms.acc.kids$inhibition, ms.acc.kids$implicature)
inhibneg_acckids <- cor.test(ms.acc.kids$inhibition, ms.acc.kids$negation)
negimp_acckids <- cor.test(ms.acc.kids$negation, ms.acc.kids$implicature)
There is no significant correlation between inhibition and implicature accuracy (r = -0.07, p = 0.55) or inhibition and negation accuracy (r = 0.09, p = 0.5).
Now let’s look at individual differences in reaction time for adults:
ggpairs(data = ms.rt.adults,
columns = 2:4,
upper = list(continuous = "cor"),
lower = list(continuous = "smooth")) +
theme_bw()
inhibimp_rtadults <- cor.test(ms.rt.adults$inhibition, ms.rt.adults$implicature)
inhibneg_rtadults <- cor.test(ms.rt.adults$inhibition, ms.rt.adults$negation)
negimp_rtadults <- cor.test(ms.rt.adults$negation, ms.rt.adults$implicature)
There is no significant correlation between inhibition and implicature reaction time (r = 0.04, p = 0.77) or inhibition and negation reaction time (r = 0.13, p = 0.36).
There is a small marginally significant correlation between adults’ RT on the negation game and the implicature game (r = 0.29, p = 0.05).
What about kids’ RT?
ggpairs(data = ms.rt.kids,
columns = 2:4,
upper = list(continuous = "cor"),
lower = list(continuous = "smooth")) +
theme_bw()
inhibimp_rtkids <- cor.test(ms.rt.kids$inhibition, ms.rt.kids$implicature)
inhibneg_rtkids <- cor.test(ms.rt.kids$inhibition, ms.rt.kids$negation)
negimp_rtkids <- cor.test(ms.rt.kids$negation, ms.rt.kids$implicature)
There is no significant correlation between inhibition and implicature reaction time (r = 0.17, p = 0.18) or inhibition and negation reaction time (r = -0.01, p = 0.95).
For the diffusion analysis, we estimated parameters separately for each trial type within each game. Parameters are estimated within each subject and then we aggregate across subjects to get means & confidence intervals on the parameters.
Plots show density of RTs for correct (pink) and incorrect responses (green), for each trial type. You can kind of see the speed-accuracy tradeoff in some of these plots, especially the inhibition trials.
#Make a bunch of plots:
ggplot(d, aes(x = q)) +
geom_density(aes(group = resp, colour = resp, fill = resp), alpha = 0.3) +
facet_grid(agegroup ~ game + trial.type, scales = "free") +
scale_fill_hue(labels = c("incorrect", "correct")) +
scale_color_hue(labels = c("incorrect", "correct")) +
theme_bw()
We calculated parameters for each trial type separately, within each subject. Then we aggregated across subjects to get means & confidence intervals on the parameters, and plotted the parameters across each game & trial type.
sub.pars <- data.frame(Separation = numeric(),
Non.Decision = numeric(),
Bias = numeric(),
Drift = numeric(),
Trial.Type = character(),
SubID = character(),
Age = character())
sub.pars$Trial.Type <- as.character(sub.pars$Trial.Type)
sub.pars$SubID <- as.character(sub.pars$SubID)
sub.pars$Age <- as.character(sub.pars$Age)
temp.pars <- sub.pars
#because RWiener is finicky:
d$resp <- as.character(d$resp)
trialtypes <- c("control", "inhib", "unambiguous", "implicature", "positive", "negative")
subs <- unique(d$subid)
for (j in 1:length(subs)) {
sid <- as.character(subs[j])
for (i in 1:length(trialtypes)) {
ttype <- as.character(trialtypes[i])
dat <- as.data.frame(subset(d, trial.labels == ttype & subid == sid))
opt <- optim(c(1, .1, .1, 1), wiener_deviance,
dat=select(dat, c(q, resp)), method="Nelder-Mead")
pars <- c(opt$par, ttype, sid, as.character(dat$agegroup[1]))
temp.pars[i,] <- pars
}
sub.pars <- rbind(temp.pars, sub.pars)
temp.pars <- temp.pars[0, ]
}
This plot shows the mean parameter values & 95% C.I.s for each game/trial type.
sub.pars <- sub.pars %>%
mutate(Condition = ifelse(Trial.Type == "control" | Trial.Type == "positive" | Trial.Type == "unambiguous", "Control", "Target"),
Game = ifelse(Trial.Type == "control" | Trial.Type == "inhib", "inhibition", ifelse(Trial.Type == "positive" | Trial.Type == "negative", "negation", "implicature")))
sub.pars$Separation <- as.numeric(sub.pars$Separation)
sub.pars$Non.Decision <- as.numeric(sub.pars$Non.Decision)
sub.pars$Bias <- as.numeric(sub.pars$Bias)
sub.pars$Drift <- as.numeric(sub.pars$Drift)
sub.pars$Kids <- sub.pars$Age != "adults"
sub.pars <- sub.pars %>%
group_by(Game, Kids) %>%
filter(Separation < mean(Separation) + 3 * sd(Separation),
Separation > mean(Separation) - 3 * sd(Separation)) %>%
filter(Non.Decision < mean(Non.Decision) + 3 * sd(Non.Decision),
Non.Decision > mean(Non.Decision) - 3 * sd(Non.Decision)) %>%
filter(Bias < mean(Bias) + 3 * sd(Bias),
Bias > mean(Bias) - 3 * sd(Bias)) %>%
filter(Drift < mean(Drift) + 3 * sd(Drift),
Drift > mean(Drift) - 3 * sd(Drift)) %>%
ungroup() %>%
na.omit()
sub.pars.ms <- sub.pars %>%
gather(Param, Value, Separation:Drift) %>%
group_by(Age, Condition, Game, Param) %>%
summarise(M = mean(Value),
cih = ci.high(Value),
cil = ci.low(Value))
sub.pars.ms$Game <- factor(sub.pars.ms$Game, levels = c("inhibition", "implicature", "negation"))
qplot(data = filter(sub.pars.ms), x = Age, color = Condition,
y = M, ymax=cih, ymin=cil,
geom = "pointrange", position = position_dodge(.25)) +
facet_grid(Param ~ Game, scales = "free") +
theme_bw()
We can also take these parameters and visualize the actual diffusion process for each game/trial type/age group:
#Visualize diffusion process for each game & trial type
games <- c("inhibition", "implicature", "negation")
age <- unique(sub.pars.ms$Age)
p <- list()
#graph axes
x <- 2
y <- 4
for (a in 1:length(age)) {
for (g in 1:length(games)) {
params <- sub.pars.ms %>%
subset(Game == games[g] & Age == age[a]) %>%
gather(Name, Value, M:cil) %>%
unite(Stats, Param, Name) %>%
spread(Stats, Value)
params$yint_M = (params$Bias_M*params$Separation_M) - (params$Drift_M*params$Non.Decision_M)
params$yint_cih = (params$Bias_M*params$Separation_M) - (params$Drift_cih*params$Non.Decision_M)
params$yint_cil = (params$Bias_M*params$Separation_M) - (params$Drift_cil*params$Non.Decision_M)
drift_ribbon <- data.frame(xvals = c(params$Non.Decision_M, #non-decision time
(params$Separation_M - params$yint_cih) / params$Drift_cih, #Point where high drift line hits separation boundary
(params$Separation_M - params$yint_M) / params$Drift_M, #Point where drift line hits separation boundary
ifelse(params$Drift_cil > 0, (params$Separation_M - params$yint_cil) / params$Drift_cil, (0 - params$yint_cil) / params$Drift_cil)), #Point where low drift line hits separation boundary or 0
ymin = c(params$Bias_M * params$Separation_M, #point where drift starts
params$Drift_cil*((params$Separation_M - params$yint_cih) / params$Drift_cih) + params$yint_cil, #point where low drift is when high drift ends
params$Drift_cil*((params$Separation_M - params$yint_M) / params$Drift_M) + params$yint_cil, #point where low drift is when drift ends
ifelse(params$Drift_cil > 0, params$Separation_M, 0)), #point where low drift ends
ymax = c(params$Bias_M * params$Separation_M, #point where drift starts
params$Separation_M, #point where drift ends
params$Separation_M, #point where drift ends
params$Separation_M),#point where drift ends
Condition = rep(params$Condition, 4))
nd_ribbon <- data.frame(xmin = params$Non.Decision_cil,
xmax = params$Non.Decision_cih,
ymin = rep(params$Bias_cil*params$Separation_cil, 2),
ymax = rep(params$Bias_cih*params$Separation_cih, 2),
Condition = params$Condition)
sep_ribbon <- data.frame(xmin = rep(c(0), 2),
xmax = rep(x, 2),
ymin = params$Separation_cil,
ymax = params$Separation_cih,
Condition = params$Condition)
df <- data.frame()
p[[g + 3*(a-1)]] <- ggplot(df) + coord_cartesian(xlim = c(0, x), ylim = c(0, y)) +
geom_point() + theme_bw() +
geom_segment(data = params,
aes(x = Non.Decision_M,
xend = (Separation_M - yint_M) / Drift_M,
y = Bias_M * Separation_M, yend = Separation_M,
color = Condition)) +
geom_rect(data = nd_ribbon,
aes(xmin = xmin,
xmax = xmax,
ymin = ymin,
ymax = ymax,
fill = Condition),
alpha=0.2) +
geom_ribbon(data = drift_ribbon,
aes(x = xvals,
ymin = ymin,
ymax = ymax,
fill = Condition),
alpha=0.2) +
geom_rect(data = sep_ribbon,
aes(xmin = xmin,
xmax = xmax,
ymin = ymin,
ymax = ymax,
fill = Condition),
alpha=0.2) +
geom_hline(data = params,
aes(yintercept = Separation_M, color = Condition),
linetype = "dashed") +
geom_hline(yintercept = 0, linetype = "dashed") +
geom_vline(data = params,
aes(xintercept = Non.Decision_M, color = Condition)) +
scale_fill_discrete(guide = FALSE) +
scale_color_discrete(guide = FALSE) +
xlab("Time (seconds)") + ylab(paste("Boundary \n Separation")) #+
#ggtitle(paste(age[a], ",", games[g], sep = " "))
}
}
plotlist <- c(list(p[[1]], p[[4]], p[[7]], p[[10]],
p[[2]], p[[5]], p[[8]], p[[11]],
p[[3]], p[[6]], p[[9]], p[[12]]), ncol = 4, nrow = 3)
do.call(grid.arrange, plotlist)
Pink = control trials and green = target trials (I removed the legend to make more space)
ms.sep.adults <- sub.pars %>%
filter(Age == "adults") %>%
select(c(Separation, SubID, Condition, Game)) %>%
spread(Condition, Separation) %>%
mutate(sdiff = scale(Target - Control)) %>%
select(-Control, -Target) %>%
spread(Game, sdiff)
ggpairs(data = ms.sep.adults,
columns = 2:4,
upper = list(continuous = "cor"),
lower = list(continuous = "smooth")) +
theme_bw()
ms.sep.kids <- sub.pars %>%
filter(Age != "adults") %>%
select(c(Separation, SubID, Condition, Game)) %>%
spread(Condition, Separation) %>%
mutate(sdiff = scale(Target - Control)) %>%
select(-Control, -Target) %>%
spread(Game, sdiff)
ggpairs(data = ms.sep.kids,
columns = 2:4,
upper = list(continuous = "cor"),
lower = list(continuous = "smooth")) +
theme_bw()
ms.nd.adults <- sub.pars %>%
filter(Age == "adults") %>%
select(c(Non.Decision, SubID, Condition, Game)) %>%
spread(Condition, Non.Decision) %>%
mutate(sdiff = scale(Target - Control)) %>%
select(-Control, -Target) %>%
spread(Game, sdiff)
ggpairs(data = ms.nd.adults,
columns = 2:4,
upper = list(continuous = "cor"),
lower = list(continuous = "smooth")) +
theme_bw()
ms.nd.kids <- sub.pars %>%
filter(Age != "adults") %>%
select(c(Non.Decision, SubID, Condition, Game)) %>%
spread(Condition, Non.Decision) %>%
mutate(sdiff = scale(Target - Control)) %>%
select(-Control, -Target) %>%
spread(Game, sdiff)
ggpairs(data = ms.nd.kids,
columns = 2:4,
upper = list(continuous = "cor"),
lower = list(continuous = "smooth")) +
theme_bw()
ms.bias.adults <- sub.pars %>%
filter(Age == "adults") %>%
select(c(Bias, SubID, Condition, Game)) %>%
spread(Condition, Bias) %>%
mutate(sdiff = scale(Target - Control)) %>%
select(-Control, -Target) %>%
spread(Game, sdiff)
ggpairs(data = ms.bias.adults,
columns = 2:4,
upper = list(continuous = "cor"),
lower = list(continuous = "smooth")) +
theme_bw()
ms.bias.kids <- sub.pars %>%
filter(Age != "adults") %>%
select(c(Bias, SubID, Condition, Game)) %>%
spread(Condition, Bias) %>%
mutate(sdiff = scale(Target - Control)) %>%
select(-Control, -Target) %>%
spread(Game, sdiff)
ggpairs(data = ms.bias.kids,
columns = 2:4,
upper = list(continuous = "cor"),
lower = list(continuous = "smooth")) +
theme_bw()
ms.drift.adults <- sub.pars %>%
filter(Age == "adults") %>%
select(c(Drift, SubID, Condition, Game)) %>%
spread(Condition, Drift) %>%
mutate(sdiff = scale(Target - Control)) %>%
select(-Control, -Target) %>%
spread(Game, sdiff)
ggpairs(data = ms.drift.adults,
columns = 2:4,
upper = list(continuous = "cor"),
lower = list(continuous = "smooth")) +
theme_bw()
ms.drift.kids <- sub.pars %>%
filter(Age != "adults") %>%
select(c(Drift, SubID, Condition, Game)) %>%
spread(Condition, Drift) %>%
mutate(sdiff = scale(Target - Control)) %>%
select(-Control, -Target) %>%
spread(Game, sdiff)
ggpairs(data = ms.drift.kids,
columns = 2:4,
upper = list(continuous = "cor"),
lower = list(continuous = "smooth")) +
theme_bw()
sub.pars$Age <- factor(sub.pars$Age, levels = c("adults", "4", "5", "6"))
sub.pars$Condition <- factor(sub.pars$Condition)
#adult t tests
inhib.bias <- sub.pars %>%
filter(Age == "adults", Game == "inhibition") %>%
select(Bias, SubID, Condition) %>%
spread(Condition, Bias)
t.test(inhib.bias$Control, inhib.bias$Target, paired = T)
##
## Paired t-test
##
## data: inhib.bias$Control and inhib.bias$Target
## t = 4.9146, df = 43, p-value = 1.338e-05
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.09938123 0.23770079
## sample estimates:
## mean of the differences
## 0.168541
inhib.nd <- sub.pars %>%
filter(Age == "adults", Game == "inhibition") %>%
select(Non.Decision, SubID, Condition) %>%
spread(Condition, Non.Decision)
t.test(inhib.nd$Control, inhib.nd$Target, paired = T)
##
## Paired t-test
##
## data: inhib.nd$Control and inhib.nd$Target
## t = -9.3618, df = 43, p-value = 6.144e-12
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.1669209 -0.1077518
## sample estimates:
## mean of the differences
## -0.1373363
imp.sep <- sub.pars %>%
filter(Age == "adults", Game == "implicature") %>%
select(Separation, SubID, Condition) %>%
spread(Condition, Separation)
t.test(imp.sep$Control, imp.sep$Target, paired = T)
##
## Paired t-test
##
## data: imp.sep$Control and imp.sep$Target
## t = 4.2129, df = 44, p-value = 0.000123
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.2223478 0.6301862
## sample estimates:
## mean of the differences
## 0.426267
imp.drift <- sub.pars %>%
filter(Age == "adults", Game == "implicature") %>%
select(Drift, SubID, Condition) %>%
spread(Condition, Drift)
t.test(imp.drift$Control, imp.drift$Target, paired = T)
##
## Paired t-test
##
## data: imp.drift$Control and imp.drift$Target
## t = 7.1506, df = 44, p-value = 6.88e-09
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.8029908 1.4332671
## sample estimates:
## mean of the differences
## 1.118129
neg.drift <- sub.pars %>%
filter(Age == "adults", Game == "negation") %>%
select(Drift, SubID, Condition) %>%
spread(Condition, Drift)
t.test(neg.drift$Control, neg.drift$Target, paired = T)
##
## Paired t-test
##
## data: neg.drift$Control and neg.drift$Target
## t = 0.80172, df = 43, p-value = 0.4271
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.1117470 0.2592219
## sample estimates:
## mean of the differences
## 0.07373745
neg.nd <- sub.pars %>%
filter(Age == "adults", Game == "negation") %>%
select(Non.Decision, SubID, Condition) %>%
spread(Condition, Non.Decision)
t.test(neg.nd$Control, neg.nd$Target, paired = T)
##
## Paired t-test
##
## data: neg.nd$Control and neg.nd$Target
## t = 5.6812, df = 43, p-value = 1.062e-06
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.04892255 0.10276989
## sample estimates:
## mean of the differences
## 0.07584622
##Inhibition game
inhib <- filter(sub.pars, Game == "inhibition")
inhib.sep <- lm(Separation ~ Age * Condition, data = inhib)
kable(summary(inhib.sep)$coefficients, digits = 3)
| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | 1.966 | 0.120 | 16.314 | 0.000 |
| Age4 | 0.796 | 0.217 | 3.670 | 0.000 |
| Age5 | 1.123 | 0.225 | 5.002 | 0.000 |
| Age6 | 0.614 | 0.207 | 2.964 | 0.003 |
| ConditionTarget | -0.157 | 0.175 | -0.893 | 0.373 |
| Age4:ConditionTarget | 0.004 | 0.312 | 0.013 | 0.990 |
| Age5:ConditionTarget | -0.094 | 0.323 | -0.290 | 0.772 |
| Age6:ConditionTarget | -0.189 | 0.294 | -0.644 | 0.520 |
inhib.nd <- lm(Non.Decision ~ Age * Condition, data = inhib)
kable(summary(inhib.nd)$coefficients, digits = 3)
| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | 0.322 | 0.029 | 10.956 | 0.000 |
| Age4 | -0.088 | 0.053 | -1.666 | 0.097 |
| Age5 | 0.006 | 0.055 | 0.106 | 0.916 |
| Age6 | 0.046 | 0.050 | 0.904 | 0.367 |
| ConditionTarget | 0.144 | 0.043 | 3.383 | 0.001 |
| Age4:ConditionTarget | 0.233 | 0.076 | 3.060 | 0.003 |
| Age5:ConditionTarget | 0.148 | 0.079 | 1.875 | 0.062 |
| Age6:ConditionTarget | 0.104 | 0.072 | 1.449 | 0.149 |
inhib.bias <- lm(Bias ~ Age * Condition, data = inhib)
kable(summary(inhib.bias)$coefficients, digits = 3)
| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | 0.469 | 0.023 | 20.401 | 0.000 |
| Age4 | -0.059 | 0.041 | -1.431 | 0.154 |
| Age5 | -0.005 | 0.043 | -0.120 | 0.904 |
| Age6 | 0.021 | 0.040 | 0.540 | 0.590 |
| ConditionTarget | -0.168 | 0.033 | -5.030 | 0.000 |
| Age4:ConditionTarget | 0.162 | 0.060 | 2.721 | 0.007 |
| Age5:ConditionTarget | 0.046 | 0.062 | 0.740 | 0.460 |
| Age6:ConditionTarget | -0.083 | 0.056 | -1.474 | 0.142 |
inhib.drift <- lm(Drift ~ Age * Condition, data = inhib)
kable(summary(inhib.drift)$coefficients, digits = 3)
| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | 3.119 | 0.119 | 26.145 | 0.000 |
| Age4 | -1.950 | 0.215 | -9.084 | 0.000 |
| Age5 | -1.575 | 0.222 | -7.082 | 0.000 |
| Age6 | -1.435 | 0.205 | -6.995 | 0.000 |
| ConditionTarget | 0.328 | 0.174 | 1.888 | 0.060 |
| Age4:ConditionTarget | -0.280 | 0.309 | -0.908 | 0.365 |
| Age5:ConditionTarget | 0.052 | 0.320 | 0.163 | 0.871 |
| Age6:ConditionTarget | -0.045 | 0.291 | -0.156 | 0.877 |
##Implicature game
imp <- filter(sub.pars, Game == "implicature")
imp.sep <- lm(Separation ~ Age * Condition, data = imp)
kable(summary(imp.sep)$coefficients, digits = 3)
| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | 1.969 | 0.127 | 15.470 | 0.000 |
| Age4 | 1.262 | 0.227 | 5.551 | 0.000 |
| Age5 | 1.318 | 0.240 | 5.490 | 0.000 |
| Age6 | 0.844 | 0.215 | 3.937 | 0.000 |
| ConditionTarget | -0.392 | 0.178 | -2.202 | 0.029 |
| Age4:ConditionTarget | -0.133 | 0.318 | -0.418 | 0.676 |
| Age5:ConditionTarget | -0.266 | 0.338 | -0.787 | 0.432 |
| Age6:ConditionTarget | -0.088 | 0.307 | -0.286 | 0.775 |
imp.nd <- lm(Non.Decision ~ Age * Condition, data = imp)
kable(summary(imp.nd)$coefficients, digits = 3)
| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | 0.531 | 0.032 | 16.520 | 0.000 |
| Age4 | -0.129 | 0.057 | -2.249 | 0.026 |
| Age5 | 0.265 | 0.061 | 4.371 | 0.000 |
| Age6 | 0.147 | 0.054 | 2.709 | 0.007 |
| ConditionTarget | 0.002 | 0.045 | 0.036 | 0.971 |
| Age4:ConditionTarget | 0.176 | 0.080 | 2.184 | 0.030 |
| Age5:ConditionTarget | 0.020 | 0.086 | 0.239 | 0.811 |
| Age6:ConditionTarget | -0.050 | 0.077 | -0.645 | 0.520 |
imp.bias <- lm(Bias ~ Age * Condition, data = imp)
kable(summary(imp.bias)$coefficients, digits = 3)
| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | 0.420 | 0.017 | 24.276 | 0.000 |
| Age4 | -0.006 | 0.031 | -0.189 | 0.850 |
| Age5 | 0.073 | 0.033 | 2.234 | 0.027 |
| Age6 | 0.004 | 0.029 | 0.136 | 0.892 |
| ConditionTarget | 0.048 | 0.024 | 1.966 | 0.051 |
| Age4:ConditionTarget | 0.007 | 0.043 | 0.151 | 0.880 |
| Age5:ConditionTarget | -0.067 | 0.046 | -1.465 | 0.144 |
| Age6:ConditionTarget | -0.058 | 0.042 | -1.389 | 0.166 |
imp.drift <- lm(Drift ~ Age * Condition, data = imp)
kable(summary(imp.drift)$coefficients, digits = 3)
| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | 2.697 | 0.102 | 26.413 | 0.000 |
| Age4 | -1.867 | 0.182 | -10.237 | 0.000 |
| Age5 | -1.406 | 0.193 | -7.305 | 0.000 |
| Age6 | -1.211 | 0.172 | -7.038 | 0.000 |
| ConditionTarget | -1.042 | 0.143 | -7.295 | 0.000 |
| Age4:ConditionTarget | 0.723 | 0.255 | 2.834 | 0.005 |
| Age5:ConditionTarget | 0.554 | 0.271 | 2.042 | 0.042 |
| Age6:ConditionTarget | 0.502 | 0.246 | 2.043 | 0.042 |
##Negation game
neg <- filter(sub.pars, Game == "negation")
neg.sep <- lm(Separation ~ Age * Condition, data = neg)
kable(summary(neg.sep)$coefficients, digits = 3)
| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | 1.663 | 0.125 | 13.263 | 0.000 |
| Age4 | 1.863 | 0.227 | 8.197 | 0.000 |
| Age5 | 1.599 | 0.235 | 6.790 | 0.000 |
| Age6 | 1.008 | 0.220 | 4.575 | 0.000 |
| ConditionTarget | 0.086 | 0.179 | 0.479 | 0.632 |
| Age4:ConditionTarget | -0.722 | 0.322 | -2.241 | 0.026 |
| Age5:ConditionTarget | -0.904 | 0.345 | -2.622 | 0.009 |
| Age6:ConditionTarget | -0.591 | 0.318 | -1.863 | 0.064 |
neg.nd <- lm(Non.Decision ~ Age * Condition , data = neg)
kable(summary(neg.nd)$coefficients, digits = 3)
| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | 0.572 | 0.034 | 16.627 | 0.000 |
| Age4 | 0.038 | 0.062 | 0.606 | 0.545 |
| Age5 | 0.103 | 0.065 | 1.595 | 0.112 |
| Age6 | 0.057 | 0.060 | 0.947 | 0.345 |
| ConditionTarget | -0.074 | 0.049 | -1.496 | 0.136 |
| Age4:ConditionTarget | 0.234 | 0.089 | 2.644 | 0.009 |
| Age5:ConditionTarget | 0.202 | 0.095 | 2.133 | 0.034 |
| Age6:ConditionTarget | 0.116 | 0.087 | 1.327 | 0.186 |
neg.bias <- lm(Bias ~ Age * Condition, data = neg)
kable(summary(neg.bias)$coefficients, digits = 3)
| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | 0.477 | 0.017 | 28.288 | 0.000 |
| Age4 | 0.059 | 0.031 | 1.943 | 0.053 |
| Age5 | -0.021 | 0.032 | -0.650 | 0.517 |
| Age6 | -0.010 | 0.030 | -0.331 | 0.741 |
| ConditionTarget | -0.049 | 0.024 | -2.013 | 0.045 |
| Age4:ConditionTarget | 0.010 | 0.043 | 0.222 | 0.825 |
| Age5:ConditionTarget | 0.000 | 0.046 | -0.007 | 0.994 |
| Age6:ConditionTarget | -0.050 | 0.043 | -1.180 | 0.240 |
neg.drift <- lm(Drift ~ Age * Condition, data = neg)
kable(summary(neg.drift)$coefficients, digits = 3)
| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | 2.026 | 0.088 | 22.916 | 0.000 |
| Age4 | -1.033 | 0.160 | -6.444 | 0.000 |
| Age5 | -0.352 | 0.166 | -2.118 | 0.035 |
| Age6 | -0.440 | 0.155 | -2.832 | 0.005 |
| ConditionTarget | -0.146 | 0.126 | -1.153 | 0.250 |
| Age4:ConditionTarget | -0.550 | 0.227 | -2.420 | 0.016 |
| Age5:ConditionTarget | -0.571 | 0.243 | -2.347 | 0.020 |
| Age6:ConditionTarget | -0.309 | 0.224 | -1.378 | 0.170 |
#Look at changes in paramaters in general across age:
sep.model <- lm(Separation ~ Age, data = sub.pars)
kable(summary(sep.model)$coefficients, digits = 3)
| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | 1.787 | 0.052 | 34.046 | 0 |
| Age4 | 1.168 | 0.094 | 12.444 | 0 |
| Age5 | 1.151 | 0.099 | 11.622 | 0 |
| Age6 | 0.686 | 0.090 | 7.595 | 0 |
nd.model <- lm(Non.Decision ~ Age, data = sub.pars)
kable(summary(nd.model)$coefficients, digits = 3)
| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | 0.488 | 0.015 | 32.372 | 0.000 |
| Age4 | 0.046 | 0.027 | 1.719 | 0.086 |
| Age5 | 0.180 | 0.028 | 6.330 | 0.000 |
| Age6 | 0.110 | 0.026 | 4.221 | 0.000 |
bias.model <- lm(Bias ~ Age, data = sub.pars)
kable(summary(bias.model)$coefficients, digits = 3)
| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | 0.430 | 0.009 | 49.643 | 0.000 |
| Age4 | 0.026 | 0.015 | 1.659 | 0.098 |
| Age5 | 0.010 | 0.016 | 0.636 | 0.525 |
| Age6 | -0.030 | 0.015 | -2.023 | 0.043 |
drift.model <- lm(Drift ~ Age, data = sub.pars)
kable(summary(drift.model)$coefficients, digits = 3)
| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | 2.450 | 0.052 | 47.110 | 0 |
| Age4 | -1.619 | 0.093 | -17.412 | 0 |
| Age5 | -1.072 | 0.098 | -10.920 | 0 |
| Age6 | -0.969 | 0.090 | -10.829 | 0 |
#Look at continuous across age group, just children
sub.pars.cont <- filter(sub.pars, Age != "adults")
sub.pars.cont$Age <- as.numeric(as.character(sub.pars.cont$Age))
cont.sep.model <- lm(Separation ~ Age, data = sub.pars.cont)
kable(summary(cont.sep.model)$coefficients, digits = 3)
| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | 4.001 | 0.320 | 12.515 | 0 |
| Age | -0.244 | 0.063 | -3.907 | 0 |
cont.nd.model <- lm(Non.Decision ~ Age, data = sub.pars.cont)
kable(summary(cont.nd.model)$coefficients, digits = 3)
| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | 0.446 | 0.099 | 4.494 | 0.000 |
| Age | 0.030 | 0.019 | 1.543 | 0.124 |
cont.bias.model <- lm(Bias ~ Age, data = sub.pars.cont)
kable(summary(cont.bias.model)$coefficients, digits = 3)
| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | 0.572 | 0.048 | 11.811 | 0.000 |
| Age | -0.028 | 0.009 | -2.969 | 0.003 |
cont.drift.model <- lm(Drift ~ Age, data = sub.pars.cont)
kable(summary(cont.drift.model)$coefficients, digits = 3)
| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | -0.387 | 0.232 | -1.666 | 0.097 |
| Age | 0.321 | 0.045 | 7.068 | 0.000 |